Attribute VB_Name = "modInterface"
'---------------------------------------------------------------------------------------
'Module : modInterface
'Date   : 07/14/2004
'Author : Chris Elwell
'Purpose: Routines customers can call to interface with the client
'---------------------------------------------------------------------------------------

Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : SetMessage()
' DateTime  : 6/9/2004
' Purpose   : Sets the lblMessage text, fontsize, forecolor, and fontbold properties on
'             frmShip.
'---------------------------------------------------------------------------------------
'
Public Sub SetMessage(ByVal strText As String, Optional intFontSize As Integer = 12, Optional vntForeColor As Variant = vbBlack, Optional blnFontBold As Boolean = True)
    
    frmShip.lblMessage.Caption = strText
    frmShip.lblMessage.FontSize = intFontSize
    frmShip.lblMessage.ForeColor = vntForeColor
    frmShip.lblMessage.FontBold = blnFontBold

End Sub
'---------------------------------------------------------------------------------------
' Procedure : SaveBoxDIMs
' DateTime  : 07/7/2004
' Purpose   : Add or update Box DIMs in Dimensions table
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub SaveBoxDIMs(ByVal strBoxName As String, ByVal str57 As String, ByVal str58 As String, ByVal str59 As String)
    
    On Error GoTo EH
    
    Dim rsBoxDIMs As New ADODB.Recordset
    Dim strQuery As String
    
    '20080122-04 Exit if a value is not numeric
    If Not IsNumeric(str57) Or Not IsNumeric(str58) Or Not IsNumeric(str59) Then Exit Sub
    
    strQuery = "SELECT * FROM Dimensions WHERE BoxName = " & SingleQuotes(strBoxName)
    rsBoxDIMs.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    If rsBoxDIMs.EOF Then
        strQuery = "INSERT INTO Dimensions VALUES ("
        strQuery = strQuery + SingleQuotes(strBoxName) + ","
        strQuery = strQuery + SingleQuotes(str57) + ","
        strQuery = strQuery + SingleQuotes(str58) + ","
        strQuery = strQuery + SingleQuotes(str59) + ")"
        g_connFSMSClient.Execute strQuery
    Else
        strQuery = "UPDATE Dimensions SET [BoxName] = " + SingleQuotes(strBoxName) + ","
        strQuery = strQuery + "[g_str57] = " + SingleQuotes(str57) + ","
        strQuery = strQuery + "[g_str58] = " + SingleQuotes(str58) + ","
        strQuery = strQuery + "[g_str59] = " + SingleQuotes(str59)
        strQuery = strQuery + " WHERE BoxName = " + SingleQuotes(strBoxName)
        g_connFSMSClient.Execute strQuery
    End If
    
Release:

    If rsBoxDIMs.State = adStateOpen Then
        rsBoxDIMs.Close
    End If
    Set rsBoxDIMs = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modInterface:SaveBoxDIMs"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : UpdateBoxDims
' DateTime  : 20080122-02
' Purpose   : Loads box DIMs to textboxes for DIMs passed
'---------------------------------------------------------------------------------------
'
Public Sub UpdateBoxDims(ByRef tb57 As TextBox, ByRef tb58 As TextBox, ByRef tb59 As TextBox, ByVal strBoxName As String)
    
    On Error GoTo EH
    
    Dim rsBoxDIMs As New ADODB.Recordset
    Dim strQuery As String
    
    strQuery = "SELECT * FROM Dimensions WHERE BoxName = " & SingleQuotes(strBoxName)
    rsBoxDIMs.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    If Not rsBoxDIMs.EOF Then
        tb57 = rsBoxDIMs!g_str57
        tb58 = rsBoxDIMs!g_str58
        tb59 = rsBoxDIMs!g_str59

' 2012-01-12, JFW, Don't clear
'    Else
'        tb57 = " H "
'        tb58 = " W "
'        tb59 = " L "
    
    End If
    
Release:

    If rsBoxDIMs.State = adStateOpen Then
        rsBoxDIMs.Close
    End If
    Set rsBoxDIMs = Nothing

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmShip:UpdateBoxDims"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : SetCurrentAccount
' DateTime  : 07/12/2004
' Purpose   : Can be used to set the current shipping account programmatically.
'             Pass the account # of the desired account.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function SetCurrentAccount(ByVal strAcctNum As String) As Boolean

    Dim i As Integer
    
    On Error GoTo EH
    
    'Loop through the combo list and see if acct# matches any entry. If yes, set the ListIndex
    'to the index then save the settings and return true.
    With frmSetup
        For i = 0 To .f10.ListCount - 1
            If strAcctNum = .f10.List(i) Then
                .f10.ListIndex = i
                Call .cmdSave_Click(0)
                SetCurrentAccount = True
                Exit For
            End If
        Next
    End With
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:SetCurrentAccount"

End Function
'---------------------------------------------------------------------------------------
' Procedure : SetCurrentIORFacility
' DateTime  : 11/5/2004
' Purpose   : Can be used to set the current IPD IOR Facility Code programmatically.
'             Pass the code of the desired account.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function SetCurrentIORFacility(ByVal strIORFacility As String) As Boolean

    Dim i As Integer
    
    On Error GoTo EH
    
    'Loop through the combo list and see if IOR Code matches any entry. If yes, set the ListIndex
    'to the index then save the settings and return true.
    With frmShip
        For i = 0 To .f1355.ListCount - 1
            If strIORFacility = .f1355.List(i) Then
                .f1355.ListIndex = i
                SetCurrentIORFacility = True
                Exit For
            End If
        Next
    End With
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:SetCurrentIORFacility"

End Function
'---------------------------------------------------------------------------------------
' Procedure : SetCurrentAltReturnAddr
' DateTime  : 2/2/2005
' Modified  : 6/26/2006 Added support for other forms, frmReturnLbl & frmAddTags
' Purpose   : Can be used to set the current Alt Return Address programmatically.
'             Pass the AddrID of the desired address.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function SetCurrentAltReturnAddr(ByVal strAddrID As String, ByVal MyForm As Form) As Boolean

    Dim i As Integer
    
    On Error GoTo EH
    
    'Loop through the combo list and see if AddrID matches any entry. If yes, set the ListIndex
    'to the index then save the settings and return true.
    With MyForm
        For i = 0 To .cboAddrID.ListCount - 1
            If strAddrID = .cboAddrID.List(i) Then
                .cboAddrID.ListIndex = i
                .cmdSave(0) = True
                SetCurrentAltReturnAddr = True
                Exit For
            End If
        Next
    End With
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:SetCurrentAltReturnAddr"

End Function
'---------------------------------------------------------------------------------------
' Procedure : SetCurrentFSMSIP
' DateTime  : 20070730-03
' Purpose   : Can be used to set the current FSMS IP programmatically.
'             Pass the FSMS IP as configured on Setup Server tab.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function SetCurrentFSMSIP(ByVal strFSMSIP As String) As Boolean

    Dim i As Integer
    
    On Error GoTo EH
    
    'If there's a current connection close it
    With frmShip
        If .wscFXRS.State = 7 Then
            .wscFXRS.Close
            .mnuConnect.Caption = "&Connect"
            
            Call AfterDisconnect
        
        End If
    End With
    
    'Loop through the combo list and see if FXSRIP matches any entry. If yes, set the ListIndex
    'to the index then save the settings and return true.
    With frmSetup
        For i = 0 To .cboFXRSIP.ListCount - 1
            If strFSMSIP = .cboFXRSIP.List(i) Then
                .cboFXRSIP.ListIndex = i
                .cmdSave(0) = True
                SetCurrentFSMSIP = True
                Exit For
            End If
        Next
    End With
    If Not SetCurrentFSMSIP Then
        MsgBox "IP Address not found. Please select from FSMS IP combo on Server" & _
             "tab in Setup."
    Else
        DebugPrint "modInterface, SetCurrentFSMSIP, calling ConnectFXRS"
        Call frmShip.ConnectFXRS
    End If

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:SetCurrentFSMSIP"

End Function

'---------------------------------------------------------------------------------------
' Procedure : CleanAllCommodities()
' DateTime  : 9/1/2005
' Purpose   : Remove commodities that can't ship
'---------------------------------------------------------------------------------------
'
Public Sub CleanAllCommodities(ByVal str1 As String)
    
    Dim strQuery As String
    
    On Error GoTo EH
    
    'Build and execute the delete query
    strQuery = "DELETE FROM IntlCommodities "
    strQuery = strQuery + " WHERE f1 = '" & str1 & "'"
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"
    strQuery = strQuery & " AND (g_str29 IS NULL OR g_str29 = '')"
    strQuery = strQuery & " AND (g_str78 IS NULL OR g_str78 = '' OR g_str80 IS NULL OR g_str80 = '')"
    g_connFSMSClient.Execute strQuery
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modInterface:CleanAllCommodities"

End Sub

Public Function CheckIntlCommodities(rsIntlCommodities As Recordset) As String
    
    On Error GoTo EH
    
    Dim strMessages As String
    
    On Error Resume Next
    rsIntlCommodities.MoveFirst
    On Error GoTo EH
    
    Do
        If rsIntlCommodities.EOF Then Exit Do
        
        If rsIntlCommodities!g_str79 & "" = "" Then
            strMessages = "Description Required" & vbCrLf
        End If
        If rsIntlCommodities!g_str82 & "" = "" Then
            strMessages = strMessages + "Number of Units Required" & vbCrLf
        End If
        If rsIntlCommodities!g_str414 & "" = "" Then
            strMessages = strMessages + "Unit of Measure Required" & vbCrLf
        End If
        If rsIntlCommodities!g_str1030 & "" = "" Then
            strMessages = strMessages + "Unit Value Required" & vbCrLf
        End If
        If rsIntlCommodities!g_str78 & "" = "" Then
            strMessages = strMessages + "Customs Value Required" & vbCrLf
        End If
        If rsIntlCommodities!g_str80 & "" = "" Then
            strMessages = strMessages + "Country of Manu Required" & vbCrLf
        End If
        
        If frmShip.chkIntlIPD.Value = 1 Or frmShip.chkIPD.Value = 1 Then
            If rsIntlCommodities!g_str81 & "" = "" Then
                strMessages = strMessages + "Harmonized Code Required for IPD" & vbCrLf
            End If
        End If
            
        If NASCAR_VERSION >= "FSMSClient v800.2.1" Then
            If rsIntlCommodities!Document1 & "" <> "" _
            Or rsIntlCommodities!Document2 & "" <> "" _
            Or rsIntlCommodities!Document3 & "" <> "" Then
                If rsIntlCommodities!g_str1275 & "" = "" _
                Or rsIntlCommodities!g_str120 & "" = "" Then
                    strMessages = strMessages + "Customs docs require Part and Marks" & vbCrLf
                End If
            End If
        End If
    
        If strMessages <> "" Then GoTo ExitHere
        rsIntlCommodities.MoveNext
    Loop

ExitHere:
    CheckIntlCommodities = strMessages
    On Error Resume Next
    rsIntlCommodities.MoveFirst
    Exit Function
EH:
    strMessages = Err.Description
    MsgBox strMessages, vbCritical, "frmShip:CommodCheck"
    Resume ExitHere
    Resume
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : InsertIntlCommodities
' DateTime  : 07/14/2004
' Modified  : 07/24/2006 Added
' Purpose   : Allows customers to enter Intl Commodities programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function InsertIntlCommodities(str1 As String, str77 As String, str79 As String, _
                                str80 As String, str81 As String, str82 As String, _
                                str83 As String, str84 As String, str414 As String, _
                                str1030 As String, str78 As String, str1275 As String, Optional str120 As String = "" _
                                , Optional strMID As String = "" _
                                , Optional strDocument1 As String = "" _
                                , Optional strDocument2 As String = "" _
                                , Optional strDocument3 As String = "" _
                                , Optional strCommodityID As String = "" _
                                ) As Boolean
    
    Dim strQuery As String
    
    On Error GoTo EH
    
    If str1 = "" Then
        InsertIntlCommodities = False
        Exit Function
    End If
    
    strQuery = "INSERT INTO IntlCommodities ( "
    strQuery = strQuery + "f1,g_str77,g_str79,g_str80,g_str81,g_str82,g_str83,g_str84,g_str414,g_str1030,g_str78,g_str1275,Workstation,g_str120 "
    If NASCAR_VERSION >= "FSMSClient v800.2.1" Then
        strQuery = strQuery + ", MID, Document1, Document2, Document3 "
    End If
    If NASCAR_VERSION >= "FSMSClient v800.2.2" Then
        strQuery = strQuery + ", CommodityID "
    End If
    strQuery = strQuery + " ) VALUES (" & SingleQuotes(str1) & ","
    strQuery = strQuery + SingleQuotes(str77) & ","
    strQuery = strQuery + SingleQuotes(str79) & ","
    strQuery = strQuery + SingleQuotes(str80) & ","
    strQuery = strQuery + SingleQuotes(str81) & ","
    strQuery = strQuery + SingleQuotes(str82) & ","
    strQuery = strQuery + SingleQuotes(str83) & ","
    strQuery = strQuery + SingleQuotes(str84) & ","
    strQuery = strQuery + SingleQuotes(str414) & ","
    strQuery = strQuery + SingleQuotes(str1030) & ","
    strQuery = strQuery + SingleQuotes(str78) & ","
    strQuery = strQuery + SingleQuotes(str1275) & ","
    strQuery = strQuery + SingleQuotes(GetSystemName) & ","
    strQuery = strQuery + SingleQuotes(str120)
    
    If NASCAR_VERSION >= "FSMSClient v800.2.1" Then
        strQuery = strQuery + ", " + SingleQuotes(strMID)
        strQuery = strQuery + ", " + SingleQuotes(strDocument1)
        strQuery = strQuery + ", " + SingleQuotes(strDocument2)
        strQuery = strQuery + ", " + SingleQuotes(strDocument3)
    End If
    If NASCAR_VERSION >= "FSMSClient v800.2.2" Then
        strQuery = strQuery + ", " + SingleQuotes(strCommodityID)
    End If
    strQuery = strQuery + ")"
    
    DebugPrint strQuery
    
    g_connFSMSClient.Execute strQuery
    InsertIntlCommodities = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:InsertIntlCommodities"

End Function
'---------------------------------------------------------------------------------------
' Procedure : DeleteIntlCommodities
' DateTime  : 07/14/2004
' Purpose   : Allows customers to delete Intl Commodities programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function DeleteIntlCommodities(strOrderID As String) As Boolean

    Dim strQuery As String
    
    On Error GoTo EH
    
    If strOrderID = "" Then
        DeleteIntlCommodities = False
        Exit Function
    End If
    
    strQuery = "DELETE FROM IntlCommodities WHERE f1 = " & SingleQuotes(strOrderID)
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"
    strQuery = strQuery & " AND (g_str29 IS NULL OR g_str29 = '')"
    
    g_connFSMSClient.Execute strQuery
    DeleteIntlCommodities = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:DeleteIntlCommodities"

End Function
'---------------------------------------------------------------------------------------
' Procedure : ShipIntlCommodities
' DateTime  : 07/14/2004
' Purpose   : Allows customers to delete Intl Commodities programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function ShipIntlCommodities(strOrderID As String, str29 As String) As Boolean

    Dim strQuery As String
    
    On Error GoTo EH
    
    If strOrderID = "" Or str29 = "" Then
        ShipIntlCommodities = False
        Exit Function
    End If
    
    strQuery = "UPDATE IntlCommodities "
    strQuery = strQuery & " SET g_str29 = " & SingleQuotes(str29)
    strQuery = strQuery & " WHERE f1 = " & SingleQuotes(strOrderID)
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"
    strQuery = strQuery & " AND (g_str29 IS NULL OR g_str29 = '')"
    
    g_connFSMSClient.Execute strQuery
    ShipIntlCommodities = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:ShipIntlCommodities"


End Function
'---------------------------------------------------------------------------------------
' Procedure : InsertMPS
' DateTime  : 07/14/2004
' Modified  : 04/24/2006 Added Sig Svcs and workstation to insert
' Purpose   : Allows customers to enter Domestic MPS programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function InsertMPS(str1 As String, str1670 As String, str57 As String, _
                                str58 As String, str59 As String, str26 As String, _
                                str25 As String, str3056 As String, str3057 As String, _
                                str3018 As String, str2399 As String) As Boolean

    Dim strQuery As String
    ' 2009-02-10, JFW, Keep MPS packages sorted
    Static strTimeStamp As String
    Static intTimeStampPlus As Integer
    
    On Error GoTo EH
    
    If str1 = "" Then
        InsertMPS = False
        Exit Function
    End If
    
    strQuery = "INSERT INTO MPS VALUES (" & SingleQuotes(str1) & ","
    strQuery = strQuery + SingleQuotes(str1670) & ","
    strQuery = strQuery + SingleQuotes(str57) & ","
    strQuery = strQuery + SingleQuotes(str58) & ","
    strQuery = strQuery + SingleQuotes(str59) & ","
    strQuery = strQuery + SingleQuotes(str26) & ","
    strQuery = strQuery + SingleQuotes(str25) & ","
    strQuery = strQuery + SingleQuotes(str3056) & ","
    strQuery = strQuery + SingleQuotes(str3057) & ","
    strQuery = strQuery + SingleQuotes(str3018) & ","
    strQuery = strQuery + SingleQuotes(str2399) & ","
    
    ' 2009-02-10, JFW, Keep MPS packages sorted
    If strTimeStamp = "" Then
        strTimeStamp = Format(Now, "YYYYMMDD HHNNSS")
        intTimeStampPlus = 0
    ElseIf strTimeStamp = Format(Now, "YYYYMMDD HHNNSS") Then
        intTimeStampPlus = intTimeStampPlus + 1
    Else
        strTimeStamp = Format(Now, "YYYYMMDD HHNNSS")
        intTimeStampPlus = 0
    End If
    strQuery = strQuery & SingleQuotes(strTimeStamp & " " & CStr(intTimeStampPlus)) & ","
    
    strQuery = strQuery + SingleQuotes(GetSystemName) & ")"
    
    g_connFSMSClient.Execute strQuery
    InsertMPS = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:InsertMPS"

End Function
'---------------------------------------------------------------------------------------
' Procedure : DeleteMPS
' DateTime  : 07/14/2004
' Purpose   : Allows customers to delete Dom MPS programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function DeleteMPS(strOrderID As String) As Boolean

    Dim strQuery As String
    
    On Error GoTo EH
    
    If strOrderID = "" Then
        DeleteMPS = False
        Exit Function
    End If
    
    strQuery = "DELETE FROM MPS WHERE f1 = " & SingleQuotes(strOrderID)
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"

    
    g_connFSMSClient.Execute strQuery
    DeleteMPS = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:DeleteMPS"


End Function
'---------------------------------------------------------------------------------------
' Procedure : InsertLTLMulti
' DateTime  : 20070703-01
' Purpose   : Allows customers to enter LTL line items programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function InsertLTLMulti(str1 As String, str6105 As String, str6106 As String, _
                                str1670 As String, str57 As String, str58 As String, _
                                str59 As String, str2931 As String, str1271 As String, _
                                str1331 As String, str79 As String, str3056 As String, _
                                str4683 As String, str6101 As String) As Boolean

    Dim strQuery As String
    
    On Error GoTo EH
    
    If str1 = "" Then
        InsertLTLMulti = False
        Exit Function
    End If
    
    strQuery = "INSERT INTO MPS VALUES (" & SingleQuotes(str1) & ","
    strQuery = strQuery + SingleQuotes(str6105) & ","
    strQuery = strQuery + SingleQuotes(str6106) & ","
    strQuery = strQuery + SingleQuotes(str1670) & ","
    strQuery = strQuery + SingleQuotes(str57) & ","
    strQuery = strQuery + SingleQuotes(str58) & ","
    strQuery = strQuery + SingleQuotes(str59) & ","
    strQuery = strQuery + SingleQuotes(str2931) & ","
    strQuery = strQuery + SingleQuotes(str1271) & ","
    strQuery = strQuery + SingleQuotes(str1331) & ","
    strQuery = strQuery + SingleQuotes(str79) & ","
    strQuery = strQuery + SingleQuotes(str3056) & ","
    strQuery = strQuery + SingleQuotes(str4683) & ","
    strQuery = strQuery + SingleQuotes(str6101) & ","
    strQuery = strQuery + SingleQuotes(GetSystemName) & ")"
    
    g_connFSMSClient.Execute strQuery
    InsertLTLMulti = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:InsertLTLMulti"

End Function
'---------------------------------------------------------------------------------------
' Procedure : DeleteLTLMulti
' DateTime  : 20070703-02
' Purpose   : Allows customers to delete LTL line items programmatically rather than
'             through the interface.
'---------------------------------------------------------------------------------------
'
Public Function DeleteLTLMulti(strOrderID As String) As Boolean

    Dim strQuery As String
    
    On Error GoTo EH
    
    If strOrderID = "" Then
        DeleteLTLMulti = False
        Exit Function
    End If
    
    strQuery = "DELETE FROM LTLMulti WHERE f1 = " & SingleQuotes(strOrderID)
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"

    
    g_connFSMSClient.Execute strQuery
    DeleteLTLMulti = True
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:DeleteLTLMulti"


End Function
'---------------------------------------------------------------------------------------
' Procedure : PurgeCheck()
' DateTime  : 4/26/2005
' Purpose   : Can be called in AfterClose or any of the CTRL-F1 thru CTRL-F12 sub to check
'             the # of pkgs in the Shipments + IPD + SmartPost tables older than the
'             # of days specified in the intNumDays parameter. The total # of pkgs is returned.
'---------------------------------------------------------------------------------------
'
Public Function PurgeCheck(ByVal intNumDays As Integer) As Long

    On Error GoTo EH

    Dim strQuery As String
    Dim rsPkgs As New ADODB.Recordset
    Dim lngTotShipments As Long
    
    'Shipments table
    strQuery = "SELECT g_str29 FROM Shipments WHERE g_str24 < " & SingleQuotes(CStr(Format(Date - intNumDays, "YYYYMMDD")))
    rsPkgs.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    'Save total returned from shipments table
    lngTotShipments = rsPkgs.RecordCount
    If rsPkgs.State = adStateOpen Then rsPkgs.Close
    
    'IPD table
    strQuery = "SELECT g_str29 FROM IPD WHERE g_str24 < " & SingleQuotes(CStr(Format(Date - intNumDays, "YYYYMMDD")))
    rsPkgs.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic

    'Add total returned from IPD table
    lngTotShipments = lngTotShipments + rsPkgs.RecordCount
    If rsPkgs.State = adStateOpen Then rsPkgs.Close

    'SmartPost table
    strQuery = "SELECT g_str29 FROM SmartPost WHERE g_str24 < " & SingleQuotes(CStr(Format(Date - intNumDays, "YYYYMMDD")))
    rsPkgs.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic

    'Add total returned from SmartPost table and return
    PurgeCheck = lngTotShipments + rsPkgs.RecordCount

Release:
    If rsPkgs.State = adStateOpen Then rsPkgs.Close
    Set rsPkgs = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modInterface:PurgeCheck"
    Resume Release

End Function
